home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1995 April / Internet Tools.iso / infoserv / gopher / Unix / gopher-gateways / gonnrp / gonnrp-2.4.Z / gonnrp-2.4
Encoding:
Text File  |  1994-08-22  |  9.3 KB  |  352 lines
  1. #!/bin/perl 
  2. # Gopher-nnrp Gateway
  3. # 23-Aug-1994 version 2.4 Chad Adams c-adams@bgu.edu
  4. # more fixes for Solaris 2.3
  5. #
  6. # 12-Apr-1994 version 2.3 Chad Adams c-adams@bgu.edu
  7. # support INN running on solaris and 'mode reader' nntp command
  8. #
  9. # 08-Jun-1993 version 2.2 Chad Adams (c-adams@bgu.edu)
  10. # remove hardcoded paths and make -G with no param work
  11. #
  12. # 28-May-1993 version 2.1 Chad Adams (c-adams@bgu.edu)
  13. # build in access control for clari groups.  Make errors returned the same
  14. #   format as server errors so our version of gopher will put them in pop
  15. #   up box.
  16. #
  17. # 28-May-1993 version 2.0 Chad Adams (c-adams@bgu.edu)
  18. # major rewrite by: Chad Adams
  19. # add newgroups database.
  20. # add multi level newsgroup menus.  [each .part. of newsgroup automaticly
  21. #   gets it's own menu instead of putting all (like all of comp) in one
  22. #   menu.  {now menus like comp.sys, comp.lang, comp.sources, ect..}]
  23. # convert to use xhdr instead of tin's xindex.  If not used with INN using
  24. #   overview files to speed up xhdr it may be slow.
  25. #
  26. # Gopher-NNTP Gateway version 1.0
  27. # Author: Daniel Schales (dan@engr.latech.edu)
  28. # Major rewrite, socket support: Doug Schales (d1s8027@sc.tamu.edu)
  29. #
  30. # Set the 4 following variables for your setup. the 2 port variables
  31. # are set to the standard, be sure to set gopherhost and nntphost to
  32. # your respective hosts.
  33. $gopherhost="your.host.here";
  34. $gopherport=2008;
  35. $nntphost="your.host.here";
  36. $nntpprt='nntp';
  37. $nntpeol="\r\n";
  38.  
  39. $gonnrp = $0; # path to this script
  40. $newsdbm = '/usr/lib/newsgroups'; # where the newsgroups dbm files are
  41.  
  42. # localaddr for clari access.  Example:
  43. # @localaddr(143, 43, 139, 67);
  44. # allows access to 143.43.*.* and 139.67.*.*
  45. @localaddr = (143, 43, 139, 67);
  46.  
  47. @INC=("/usr/local/lib/perl");
  48. require 'sys/socket.ph';
  49. dump QUICKSTART if @ARGV[0] eq '-dump';
  50. QUICKSTART:
  51.  
  52. $SIG{'ALRM'} = 'stuck';
  53. $option=shift;
  54. $option = '-h' if $option eq '-t';
  55. while ($option eq '-f') {
  56.       $copyright = shift;
  57.       $option = shift;
  58.       open(CR, $copyright);
  59.       $title = <CR>;
  60.       close(CR);
  61.       chop($title);
  62.       print "0$title\t$copyright\t$gopherhost\t$gopherport\r\n";
  63. }
  64. $item=shift;
  65. if ($option eq '-X') {
  66.     @arts = @ARGV;
  67. } else {
  68.     $lookup=shift;
  69. }
  70. if ($item =~ m/^clari/) {
  71.     $sockaddr = 'S n a4 x8';
  72.     ($fam, $proto, $addr) = unpack($sockaddr,getpeername(STDIN));
  73.     @inetaddr = unpack('C4',$addr);
  74.     for ($i = 0; $i < $#localaddr; $i += 2) {
  75.         $validaccess = 1 if @localaddr[$i] == @inetaddr[0] &&
  76.             @localaddr[$i+1] == @inetaddr[1];
  77.     }
  78.     $_ = "Off site access not allowed to $item  ";
  79.     &checkcode($validaccess,1);
  80. }
  81.  
  82. # set an alarm 5 minutes from now, if it goes off we must be stuck
  83. alarm(300);
  84. #open(LOG,">>/tmp/nntplog");
  85. #$date=`date`;chop($date);
  86. #print LOG $date," ",$option," ",$item," ",$lookup,"\n";
  87. #close(LOG);
  88. $sockaddr = 'S n a4 x8';
  89. ($name, $aliases, $proto) = getprotobyname('tcp');
  90. ($name, $aliases, $nntpport) = getservbyname($nntpprt, 'tcp');
  91. ($name, $aliases, $type, $len, $nntpaddr) = gethostbyname($nntphost);
  92.  
  93. $rsockaddr = pack($sockaddr, &AF_INET, $nntpport, $nntpaddr);
  94.  
  95. socket(NNTPSOCK, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  96. connect(NNTPSOCK, $rsockaddr) || die "connect: $!";
  97.  
  98. select(NNTPSOCK); $|= 1; select(stdout);
  99.  
  100. $_ = <NNTPSOCK>;
  101. print NNTPSOCK "MODE READER$nntpeol";
  102. $_ = <NNTPSOCK>;
  103.  
  104. if ($option eq '-g') {
  105.     dbmopen(newsgroups, $newsdbm, 0444);
  106.     print NNTPSOCK "LIST$nntpeol";
  107.     $_ = <NNTPSOCK>;
  108.     chop; chop;
  109.     while($_ ne "."){
  110.     if($_ =~ "^$item"){
  111.         ($group) = split;
  112.         push(@out,"1$group - $newsgroups{$group}\texec:-h $group:".
  113.             "$gonnrp\t$gopherhost\t$gopherport\r\n");
  114.     }
  115.     $_ = <NNTPSOCK>;
  116.     chop; chop;
  117.     }
  118.     print sort(@out);
  119.     print ".\r\n";
  120. } elsif ($option eq '-G') {
  121.     dbmopen(newsgroups, $newsdbm, 0444);
  122.     print NNTPSOCK "LIST$nntpeol";
  123.     $_ = <NNTPSOCK>;
  124.     chop; chop;
  125.     if ($item ne '') {
  126.     $itemlen = length($item) + 1;
  127.     $dot = '.';
  128.     } else {
  129.     $itemlen = 0;
  130.     $dot = '';
  131.     }
  132.     @grouplist = ();
  133.     while($_ ne "."){
  134.     if($_ =~ "^$item"){
  135.             ($group) = split;
  136.         push(@grouplist, $group);
  137.     }
  138.         $_ = <NNTPSOCK>;
  139.         chop; chop;
  140.     }
  141.     @grouplist = sort(@grouplist);
  142.     for ($i = 0; $i <= $#grouplist; $i++) {
  143.         $group = @grouplist[$i];
  144.         if ($group eq $item) {
  145.         $grp = $group;
  146.             print "1$newsgroups{$group}\texec:-T $group:".
  147.             "$gonnrp\t$gopherhost\t$gopherport\r\n";
  148.         } else {
  149.         $grp = substr($group,$itemlen,40);
  150.         if (index($grp,'.') != -1) {
  151.             @grppart = split(/\./,$grp);
  152.             if (@grppart[0] eq $oldgrp) {
  153.             next;
  154.             }
  155.             $oldgrp = @grppart[0];
  156.             $grp = @grppart[0];
  157.                 print "1$grp - ".$newsgroups{"$item$dot$grp.all"}.
  158.             "\texec:-G $item$dot$grp".
  159.             ":$gonnrp\t$gopherhost\t$gopherport\r\n";
  160.         } else {
  161.             if ($group eq substr(@grouplist[$i+1],0,length($group))) {
  162.                     print "1$grp - ".$newsgroups{"$item$dot$grp.all"}.
  163.                 "\texec:-G $group:".
  164.                 "$gonnrp\t$gopherhost\t$gopherport\r\n";
  165.             $oldgrp = $grp;
  166.             } else {
  167.                     print "1$grp - $newsgroups{$group}\texec:-T $group:".
  168.                 "$gonnrp\t$gopherhost\t$gopherport\r\n";
  169.             }
  170.         }
  171.         }
  172.     }
  173.     print ".\r\n";
  174. } elsif($option eq '-X') {
  175. #    $item = newsgroup
  176. #    @arts = articles in this thread
  177. #      or
  178. #    @arts = 0 low high  if list would be too long
  179.     ($code) = &group($item);
  180.     # build arts array if we were passed range
  181.     @arts = split(' ', &buildidx(@arts[1], @arts[2])) if @arts[0] == 0;
  182.     foreach $art (@arts) { $goodart{$art} = 1; }
  183.     &xhdr('from', @arts[0], @arts[$#arts]);
  184.     while (<NNTPSOCK>) {
  185.         last if substr($_,0,1) eq '.';
  186.         chop; chop;
  187.         ($art, $from) = split(/ /,$_,2);
  188.         print "0$from\texec:-a ${item} $art:$gonnrp\t".
  189.             "$gopherhost\t$gopherport\r\n" if $goodart{$art};
  190.     }
  191.     print ".\r\n";
  192. } elsif($option eq '-T') {
  193.     ($code, $cnt, $low, $high) = &group($item);
  194.     &buildidx($low, $high);
  195.     @keys = sort(keys %idx);
  196.     foreach $key (@keys) {
  197.         @arts = split(' ',$idx{$key});
  198.         if ($#arts == 0) { # single article
  199.             print "0$key\texec:-a ${item} @arts[0]:".
  200.               "$gonnrp\t$gopherhost\t$gopherport\r\n";
  201.         } else { # thread
  202.             if (length($idx{$key}) < 80) { # send article list
  203.                 print "1$key\texec:-X $item$idx{$key}:".
  204.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  205.             } else { # give range
  206.                 print "1$key\texec:".
  207.                   "-X $item 0 @arts[0] @arts[$#arts]:".
  208.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  209.             }
  210.         }
  211.     }
  212.     print ".\r\n";
  213. } elsif($option eq '-l'){
  214.     ($code, $count, $start, $end) = &group($item);
  215.     if($count ne "0"){
  216.         print NNTPSOCK "ARTICLE $end$nntpeol";
  217.         $body=0;
  218.         $_ = <NNTPSOCK>;
  219.         chop; chop;
  220.         while($_ ne "."){
  221.             if ($body) {
  222.                 print "$_\r\n";
  223.             } elsif ($_ =~ "^220 " || $_ =~ "^222 ") {
  224.                 $body = 1;
  225.             }
  226.         }
  227.              $_ = <NNTPSOCK>;
  228.              chop; chop;
  229.      }
  230. }
  231. # rwp 20Aug92 Add ability to fetch last article.
  232.  
  233. elsif($option eq '-h' || $option eq '-b' || $option eq '-s'){
  234.     ($code, $count, $start, $end) = &group($item);
  235.     if($count ne "0"){
  236.         &xhdr('subject', $start, $end);
  237.         $_ = <NNTPSOCK>;
  238.         chop; chop;
  239.         while($_ ne '.'){
  240.             ($num,$desc) = split (/ /,$_,2);
  241.             if ($option eq '-h' ) {
  242.                 print "0$desc\texec:-a ${item} ${num}:".
  243.                   "$gonnrp\t$gopherhost\t$gopherport\r\n";
  244.             } elsif ($option eq '-b') {
  245.                 print "0$desc\texec:-a ${item} ${num} body".
  246.                   ":$gonnrp\t$gopherhost\t$gopherport\r\n";
  247.             } elsif ($option eq '-s') {
  248.                 $desc1="\L$desc\E";
  249.                 $lookup1 ="\L$lookup\E";
  250.                 if ($desc1 =~ $lookup1 ) {
  251.                  print "0$desc\texec:-a ${item} ${num}:".
  252.                   "$gonnrp\t$gopherhost\t$gopherport\t\r\n";
  253.                 }
  254.             }
  255.             $_ = <NNTPSOCK>;
  256.             chop; chop;
  257.         }
  258.     }
  259.     print ".\r\n";
  260. } elsif($option eq '-a'){
  261.     $num = $lookup;
  262.     $part = shift;
  263.     ($code) = &group($item);
  264.     if($part eq "body") {
  265.         print NNTPSOCK "BODY $num$nntpeol";
  266.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  267.         &checkcode($code,222);
  268.     } else {
  269.         print NNTPSOCK "ARTICLE $num$nntpeol";
  270.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  271.         &checkcode($code,220);
  272.     }
  273.     $_ = <NNTPSOCK>;
  274.     chop; chop;
  275.     while($_ ne "."){
  276.         print "$_\r\n";
  277.         $_ = <NNTPSOCK>;
  278.         chop; chop;
  279.     }
  280. }
  281.  
  282. print NNTPSOCK "QUIT$nntpeol";
  283. shutdown(NNTPSOCK, 2);
  284. exit(0);
  285.  
  286. sub stuck {
  287. open(LOG,">>/tmp/nntplog");
  288. $date=`date`;chop($date);
  289. print LOG $date," hung on ",$option," ",$item," ",$lookup,"\n";
  290. close(LOG);
  291.  
  292. exit;
  293. }
  294.  
  295. # Chad Adams  28-May-1993  tin's xindex to xhdr conversion
  296. sub checkcode { # return error when nntp command failes
  297.     local($code, $goodcode) = @_;
  298.     if ($code != $goodcode) {
  299.         chop; chop;
  300.         print "0nnrp error: $_\t\terror.host\t1\r\n";
  301.         print ".\r\n";
  302.         exit;
  303.     }
  304. }
  305. sub buildidx {    # build subject threads
  306.     local ($low, $high) = @_;
  307.     local ($first, $fsubj, $re, $subj);
  308.     $first = 1;
  309.     &xhdr('subject', $low, $high);
  310.     $cnt = 0;
  311.     while (<NNTPSOCK>) {
  312.         last if substr($_,0,1) eq '.';
  313.         chop; chop;
  314.         ($art, $subj) = split(/ /,$_,2);
  315.         while (1) { # remove Re:
  316.             $re = substr($subj,0,2);
  317.             $re =~ tr/A-Z/a-z/;
  318.             if ($re eq 're') {
  319.                 $subj = substr($subj,2);
  320.                 next;
  321.             } elsif (substr($subj,0,1) eq ':') {
  322.                 $subj = substr($subj,1);
  323.                 next;
  324.             } elsif (substr($subj,0,1) eq ' ') {
  325.                 $subj = substr($subj,1);
  326.                 next;
  327.             }
  328.             last;
  329.         }
  330.         if ($first) {
  331.             $fsubj = $subj;
  332.             $first = 0;
  333.         }
  334.         $idx{$subj} .= " $art";
  335.         $cnt++;
  336.     }
  337.     return $idx{$fsubj};
  338. }
  339. sub group { # (code, count, low, high) = &group(newsgroup)
  340.     local(@rtn);
  341.     print NNTPSOCK "group @_[0]$nntpeol";
  342.     @rtn = split(/ /,($_ = <NNTPSOCK>), 5);
  343.     &checkcode(@rtn[0],211);
  344.     return @rtn;
  345. }
  346. sub xhdr { # &xhdr(header,low,high)
  347.     local($code);
  348.     print NNTPSOCK "xhdr @_[0] ".@_[1].'-'.@_[2].$nntpeol;
  349.     ($code) = split(/ /,($_ = <NNTPSOCK>));
  350.     &checkcode($code,221);
  351. }
  352.